home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 021-030 / amok21 / iffsupport1.5 / demos / saveiff.mod < prev    next >
Text File  |  1993-11-04  |  13KB  |  426 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.    SaveIFF.mod
  3.     :Author.     Fridtjof Siebert
  4.     :Address.    Nobileweg 67, D-7-Stgt-40
  5.     :Phone.      0711/822509
  6.     :Shortcut.   [fbs]
  7.     :Version.    1.0
  8.     :Date.       26-Jun-88
  9.     :Copyright.  PD
  10.     :Language.   Modula-II
  11.     :Translator. M2Amiga
  12.     :Imports.    none.
  13.     :UpDate.     none.
  14.     :Contents.   Speichert Screens und Windows als IFF-Files.
  15.     :Remark.     Demonstartion für IFFSupport.
  16. ---------------------------------------------------------------------------*)
  17.  
  18. MODULE SaveIFF;
  19.  
  20. FROM SYSTEM     IMPORT ADR, ADDRESS, BITSET, LONGSET, SHIFT, CAST;
  21. FROM Arts       IMPORT TermProcedure, Assert;
  22.  
  23. FROM Dos        IMPORT Delay;
  24. FROM Exec       IMPORT Forbid, GetMsg, Permit, ReplyMsg, WaitPort;
  25. FROM Graphics   IMPORT Text, Move, Draw, SetAPen, SetDrMd, jam1, jam2,
  26.                        RastPortPtr, SetBPen, Rectangle, RectFill;
  27. FROM Intuition  IMPORT IntuitionBase, NewWindow, OpenWindow, CloseWindow,
  28.                        WindowFlags, WindowFlagSet, Gadget, GadgetFlags,
  29.                        GadgetFlagSet, WindowPtr, ActivationFlags,
  30.                        ActivationFlagSet, ScreenFlags, ScreenFlagSet,
  31.                        IDCMPFlags, IDCMPFlagSet, RefreshGadgets, strGadget,
  32.                        StringInfo, IntuiMessagePtr, GadgetPtr, ScreenPtr,
  33.                        boolGadget, CloseScreen, DisplayBeep;
  34.  
  35. FROM Strings    IMPORT Length, Copy, first, last;
  36.  
  37. FROM IFFSupport IMPORT ReadILBM, ReadILBMFlags, ReadILBMFlagSet, WriteILBM;
  38. IMPORT Intuition;
  39.  
  40. TYPE
  41.   Gadgets = (scrn0,scrn1,scrn2,scrn3,scrn4,scrn5,scrn6,scrn7,scrn8,scrn9,
  42.              wind0,wind1,wind2,wind3,wind4,wind5,wind6,wind7,wind8,wind9,
  43.              name, savescrn, savewind, savegzz, showiff, dummy);
  44.  
  45. VAR
  46.   Intuitionbase: POINTER TO IntuitionBase;   (* IntuitionBasePtr           *)
  47.   NuWindow: NewWindow;
  48.   Window: WindowPtr;                         (* SaveIFF's Window           *)
  49.   RP: RastPortPtr;                           (* It's RastPort              *)
  50.   Gadgs: ARRAY Gadgets OF Gadget;            (* It's Gadgets               *)
  51.   NameInfo: StringInfo;                      (* IFF-Name's Gadget's Info   *)
  52.   Name: ARRAY[0..79] OF CHAR;                (* IFF-Name                   *)
  53.   IDCount: Gadgets;                          (* Counting Gadgets           *)
  54.   ChosenScreen, ChosenWindow: Gadgets;       (* User-Selected Screnn&Window*)
  55.   Screen: ScreenPtr;                         (* Screen for Loaded IFF-File *)
  56.   DummyWind: WindowPtr;                      (* only a Dummy               *)
  57.   Screens: ARRAY[scrn0..scrn9] OF ScreenPtr; (* ScreenPtrs                 *)
  58.   Windows: ARRAY[wind0..wind9] OF WindowPtr; (* WindowPtrs                 *)
  59.   NumScreens, NumWindows: Gadgets;           (* How many are in that List? *)
  60.   gadget: GadgetPtr;                         (* Gadget causing a Message   *)
  61.   Msg: IntuiMessagePtr;                      (* Receives Messages          *)
  62.   Rect: Rectangle;                           (* Rectangle for Windows      *)
  63.   Ciapra [0BFE001H]: SET OF (s0,s1,s2,s3,s4,s5,lmb);
  64.  
  65. (*-----------------------  Small Procedures:  -----------------------------*)
  66.  
  67. (*------  Set a Bool-Gadget:  ------*)
  68.  
  69. PROCEDURE SetBool(VAR Gadg: Gadget; x,y,w,h: INTEGER);
  70.  
  71. BEGIN
  72.   WITH Gadg DO
  73.     nextGadget := NIL;
  74.     leftEdge := x;  topEdge := y;
  75.     width    := w;  height  := h;
  76.     flags    := GadgetFlagSet{};
  77.     activation   := ActivationFlagSet{gadgImmediate,toggleSelect};
  78.     gadgetType   := boolGadget;
  79.     gadgetRender := NIL;
  80.     selectRender := NIL;
  81.     gadgetText   := NIL;
  82.     mutualExclude:= LONGSET{};
  83.     specialInfo  := NIL;
  84.     gadgetID     := 0;
  85.     userData     := NIL;
  86.   END;
  87. END SetBool;
  88.  
  89. (*------  Draw A Box:  ------*)
  90.  
  91. PROCEDURE Box(rp: RastPortPtr; x,y,X,Y: INTEGER);
  92.  
  93. BEGIN
  94.   Move(rp,x,y); Draw(rp,X,y); Draw(rp,X,Y); Draw(rp,x,Y); Draw(rp,x,y);
  95. END Box;
  96.  
  97. (*------  Type Text:  ------*)
  98.  
  99. TYPE
  100.   TypeTextType = POINTER TO ARRAY[0..999] OF CHAR;
  101.  
  102. PROCEDURE Type(rp: RastPortPtr; x,y: INTEGER; text:TypeTextType);
  103.  
  104. BEGIN
  105.   Move(rp,x,y); Text(rp,text,Length(text^));
  106. END Type;
  107.  
  108. (*-------------------------------------------------------------------------*)
  109. (*                                                                         *)
  110. (*                      Refresh Display: (Gadgets & Names)                 *)
  111. (*                                                                         *)
  112. (*-------------------------------------------------------------------------*)
  113.  
  114. PROCEDURE Refresh(Display: BOOLEAN);
  115. (* IF NOT(Display) THEN Don't make anything affecting the display          *)
  116.  
  117. VAR
  118.   SearchScreen: ScreenPtr;
  119.   SearchWindow: WindowPtr;
  120.   SearchName: ARRAY[0..79] OF CHAR;
  121.   NamePtr: POINTER TO ARRAY[0..255] OF CHAR;
  122.  
  123. BEGIN
  124.  
  125. (*------  Delete highlighted Gadgets:  ------*)
  126.  
  127.   IF Display THEN RefreshGadgets(ADR(Gadgs),Window,NIL) END;
  128.  
  129. (*------  Get ScreenNames:  ------*)
  130.  
  131.   IF Display THEN
  132.     SetAPen(RP,0); SetDrMd(RP,jam1); RectFill(RP,9,27,143,109);
  133.     SetAPen(RP,1); SetBPen(RP,0); SetDrMd(RP,jam2);
  134.   END;
  135.   IDCount := scrn0;
  136.   Forbid();
  137.   SearchScreen := Intuitionbase^.firstScreen;
  138.   WHILE (SearchScreen#NIL) AND (IDCount<=scrn9) DO
  139.     Screens[IDCount] := SearchScreen;
  140.     IF SearchScreen^.title=NIL THEN
  141.       SearchName := "Unnamed";
  142.     ELSE
  143.       NamePtr := SearchScreen^.title;
  144.       Copy(SearchName,NamePtr^,first,16);
  145.     END;
  146.     IF Display THEN Type(RP, 12,35+8*ORD(IDCount),ADR(SearchName)) END;
  147.     INC(IDCount);
  148.     SearchScreen := SearchScreen^.nextScreen;
  149.   END;
  150.   Permit();
  151.   NumScreens := IDCount;
  152.   IF ChosenScreen>=NumScreens THEN ChosenScreen := scrn0 END;
  153.  
  154. (*------  Get WindowNames:  ------*)
  155.  
  156.   IF Display THEN
  157.     SetAPen(RP,0); SetDrMd(RP,jam1); RectFill(RP,153,27,287,109);
  158.     SetAPen(RP,1); SetBPen(RP,0); SetDrMd(RP,jam2);
  159.   END;
  160.   IDCount := wind0;
  161.   Forbid();
  162.   SearchWindow := Screens[ChosenScreen]^.firstWindow;
  163.   WHILE (SearchWindow#NIL) AND (IDCount<=wind9) DO
  164.     Windows[IDCount] := SearchWindow;
  165.     IF SearchWindow^.title=NIL THEN
  166.       SearchName := "Unnamed";
  167.     ELSE
  168.       NamePtr := SearchWindow^.title;
  169.       Copy(SearchName,NamePtr^,first,16);
  170.     END;
  171.     IF Display THEN Type(RP,156,8*ORD(IDCount)-45,ADR(SearchName)) END;
  172.     INC(IDCount);
  173.     SearchWindow := SearchWindow^.nextWindow;
  174.   END;
  175.   Permit();
  176.   NumWindows := IDCount;
  177.   IF ChosenWindow>=NumWindows THEN
  178.     IF NumWindows=wind0 THEN
  179.       ChosenWindow := dummy;
  180.     ELSE
  181.       ChosenWindow := wind0;
  182.     END;
  183.   END;
  184.  
  185. (*------  Set Gadgets:  ------*)
  186.  
  187.   IF Display THEN
  188.     FOR IDCount := scrn0 TO showiff DO
  189.       WITH Gadgs[IDCount] DO
  190.         flags := flags - GadgetFlagSet{selected};
  191.       END;
  192.     END;
  193.     INCL(Gadgs[ChosenScreen].flags,selected);
  194.     INCL(Gadgs[ChosenWindow].flags,selected);
  195.   END;
  196.  
  197. (*------  Refresh:  ------*)
  198.  
  199.   IF Display THEN RefreshGadgets(ADR(Gadgs),Window,NIL) END;
  200.  
  201. END Refresh;
  202.  
  203. (*--------------------------  Clean Up:  ----------------------------------*)
  204.  
  205. PROCEDURE CleanUp();
  206.  
  207. BEGIN
  208.   IF Window#NIL THEN CloseWindow(Window) END;
  209.   IF Screen#NIL THEN CloseScreen(Screen) END;
  210. END CleanUp;
  211.  
  212. (*-------------------------------------------------------------------------*)
  213. (*                                                                         *)
  214. (*                             M A I N :                                   *)
  215. (*                                                                         *)
  216. (*-------------------------------------------------------------------------*)
  217.  
  218. BEGIN
  219.  
  220. (*------  Init Variables:  ------*)
  221.  
  222.   Window := NIL;
  223.   Intuitionbase := NIL;
  224.   Screen := NIL;
  225.   TermProcedure(CleanUp);
  226.   Name := "df0:Pic.iff";
  227.   ChosenScreen := scrn0;
  228.   ChosenWindow := wind0;
  229.  
  230. (*------  Open Intuition:  ------*)
  231.  
  232.   Intuitionbase := ADR(Intuition);
  233.   Assert(Intuitionbase#NIL,ADR("SaveIFF: Can't open Intuition"));
  234.  
  235. (*------------------------  Build up Display:  ----------------------------*)
  236.  
  237. (*------  Gadgets: ------*)
  238.  
  239.   FOR IDCount:=scrn0 TO scrn9 DO
  240.     SetBool(Gadgs[IDCount],9,29+8*ORD(IDCount),135,8);
  241.     SetBool(Gadgs[Gadgets(ORD(IDCount)+ORD(wind0))],153,29+8*ORD(IDCount),
  242.             135,8);
  243.   END;
  244.   SetBool(Gadgs[name    ], 60,116,224, 8);
  245.   WITH Gadgs[name] DO
  246.     activation  := ActivationFlagSet{stringCenter};
  247.     gadgetType  := strGadget;
  248.     specialInfo := ADR(NameInfo);
  249.   END;
  250.   WITH NameInfo DO
  251.     buffer := ADR(Name);
  252.     undoBuffer := NIL;
  253.     bufferPos  := 0;
  254.     maxChars   := 80;
  255.     dispPos    := 0;
  256.     numChars   := Length(Name);
  257.   END;
  258.   SetBool(Gadgs[savescrn],  9,131,135,11);
  259.   SetBool(Gadgs[savewind],153,131,135,11);
  260.   SetBool(Gadgs[savegzz ],  9,147,135,11);
  261.   SetBool(Gadgs[showiff ],153,147,135,11);
  262.  
  263. (*------  Link Gadgets:  ------*)
  264.  
  265.   FOR IDCount := scrn0 TO savegzz DO
  266.     WITH Gadgs[IDCount] DO
  267.       nextGadget := ADR(Gadgs[Gadgets(ORD(IDCount)+1)]);
  268.       gadgetID := ORD(IDCount);
  269.     END;
  270.   END;
  271.   WITH Gadgs[showiff] DO
  272.     nextGadget := NIL;
  273.     gadgetID := ORD(showiff)
  274.   END;
  275.  
  276. (*------  Window:  ------*)
  277.  
  278.   WITH NuWindow DO
  279.     leftEdge   := 172;  topEdge   := 36;
  280.     width      := 296;  height    := 164;
  281.     detailPen  := 0;    blockPen  := 1;
  282.     idcmpFlags := IDCMPFlagSet{gadgetDown,closeWindow};
  283.     flags      := WindowFlagSet{windowDrag,windowDepth,windowClose,activate,
  284.                                 noCareRefresh};
  285.     firstGadget:= ADR(Gadgs);
  286.     checkMark  := NIL;
  287.     title      := ADR("SaveIFF - © F. Siebert");
  288.     screen     := NIL;
  289.     bitMap     := NIL;
  290.     type       := ScreenFlagSet{wbenchScreen};
  291.   END;
  292.  
  293.   Window := OpenWindow(NuWindow);
  294.   Assert(Window#NIL,ADR("SaveIFF: Can't open Window"));
  295.   RP := Window^.rPort;
  296.  
  297. (*------  Draw into Window:  ------*)
  298.  
  299.   SetAPen(RP,2); SetDrMd(RP,jam1);
  300.   Box(RP,  8, 26,144,110); Box(RP,152, 26,288,110);
  301.   Box(RP, 56,114,288,126); Box(RP,  8,130,144,142);
  302.   Box(RP,152,130,288,142); Box(RP,  8,146,144,158);
  303.   Box(RP,152,146,288,158);
  304.  
  305. (*------  Type Text into Window:  ------*)
  306.  
  307.   SetAPen(RP,1);
  308.   Type(RP,  8, 23,ADR("Screens:"));
  309.   Type(RP,152, 23,ADR("Windows:"));
  310.   Type(RP,  8,123,ADR("Name:"));
  311.   Type(RP, 36,139,ADR("Save Screen"));
  312.   Type(RP,180,139,ADR("Save Window"));
  313.   Type(RP, 28,155,ADR("Save GimmeZZ"));
  314.   Type(RP,188,155,ADR("Show IFF"));
  315.  
  316. (*------  Initialize Display:  ------*)
  317.  
  318.   Refresh(TRUE);
  319.  
  320. (*----------------------------  Get Messages:  ----------------------------*)
  321.  
  322.   LOOP
  323.  
  324.     WaitPort(Window^.userPort);
  325.     Msg := GetMsg(Window^.userPort);
  326.     IF closeWindow IN Msg^.class THEN
  327.       ReplyMsg(Msg);
  328.       EXIT;
  329.     END;
  330.     gadget := Msg^.iAddress;
  331.     ReplyMsg(Msg);
  332.  
  333.     IDCount := Gadgets(gadget^.gadgetID);
  334.  
  335.     CASE IDCount OF
  336.  
  337. (*------  Screen-Gadget:  ------*)
  338.  
  339.     scrn0..scrn9:
  340.       IF IDCount<NumScreens THEN
  341.         ChosenScreen := IDCount;
  342.       ELSE
  343.         DisplayBeep(NIL);
  344.       END; |
  345.  
  346. (*------  Window-Gadget:  ------*)
  347.  
  348.     wind0..wind9:
  349.       IF IDCount<NumWindows THEN
  350.         ChosenWindow := IDCount;
  351.       ELSE
  352.         DisplayBeep(NIL);
  353.       END; |
  354.  
  355. (*------  SaveScrn:  ------*)
  356.  
  357.     savescrn:
  358.       Refresh(FALSE);
  359.       WITH Screens[ChosenScreen]^ DO
  360.         IF NOT(WriteILBM(Name,ADR(rastPort),ADR(viewPort),NIL,TRUE)) THEN
  361.           DisplayBeep(NIL);
  362.         END;
  363.       END; |
  364.  
  365. (*------  savewind:  ------*)
  366.  
  367.     savewind:
  368.       Refresh(FALSE);
  369.       IF ChosenWindow#dummy THEN
  370.         WITH Windows[ChosenWindow]^ DO
  371.           WITH Rect DO
  372.             minX := leftEdge;
  373.             minY := topEdge;
  374.             maxX := minX + width - 1;
  375.             maxY := minY + height - 1;
  376.           END;
  377.           IF NOT(WriteILBM(Name,rPort,ADR(wScreen^.viewPort),ADR(Rect),
  378.                  TRUE)) THEN
  379.             DisplayBeep(NIL);
  380.           END;
  381.         END;
  382.       ELSE
  383.         DisplayBeep(NIL);
  384.       END; |
  385.  
  386. (*------  Save GimmeZeroZero:  ------*)
  387.  
  388.     savegzz:
  389.       Refresh(FALSE);
  390.       IF ChosenWindow#dummy THEN
  391.         WITH Windows[ChosenWindow]^ DO
  392.           WITH Rect DO
  393.             minX := leftEdge + ORD(borderLeft);
  394.             minY := topEdge + ORD(borderTop);
  395.             maxX := minX + gzzWidth - 1;
  396.             maxY := minY + gzzHeight - 1;
  397.           END;
  398.           IF NOT(WriteILBM(Name,rPort,ADR(wScreen^.viewPort),ADR(Rect),
  399.                  TRUE)) THEN
  400.             DisplayBeep(NIL);
  401.           END;
  402.         END;
  403.       ELSE
  404.         DisplayBeep(NIL);
  405.       END; |
  406.  
  407. (*------  ShowIFF:  ------*)
  408.  
  409.     showiff:
  410.       IF ReadILBM(Name,ReadILBMFlagSet{front,visible},Screen,DummyWind) THEN
  411.          WHILE lmb IN Ciapra DO Delay(5) END; (* Wait for Left Button *)
  412.          CloseScreen(Screen);
  413.          Screen := NIL;
  414.       ELSE
  415.         DisplayBeep(NIL);
  416.       END; |
  417.  
  418.     ELSE
  419.     END;
  420.  
  421.     Refresh(TRUE);
  422.  
  423.   END;   (* LOOP *)
  424.  
  425. END SaveIFF.
  426.